home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 6 / CU Amiga Magazine's Super CD-ROM 06 (1996)(EMAP Images)(GB)(Track 1 of 4)[!][issue 1997-01].iso / cucd / prog / mui / modula / demo / class3.mod < prev    next >
Text File  |  1996-02-07  |  12KB  |  356 lines
  1. MODULE Class3 ;
  2.  
  3. (*
  4. ** Class3.mod by Olaf "Olf" Peters <olf@informatik.uni-bremen.de>
  5. **
  6. ** based upon Class3.c by Stefan Stuntz.
  7. **
  8. ** Updated Feb 07, 1996 by Olaf Peters
  9. ** - now uses MuiClassSupport for Classinitialisation
  10. **
  11. ** Updated Nov 27, 1995 by Olaf Peters:
  12. **  - does not use MUIOBSOLETE tags any longer
  13. **  - uses "the ideal input loop for an object oriented MUI application"
  14. **      (see MUI_Application.doc/MUIM_Application_NewInput)
  15. *)
  16.  
  17. (*$ RangeChk := FALSE *)
  18.  
  19. FROM SYSTEM     IMPORT  TAG, ADR, ADDRESS, LONGSET, CAST, SETREG, REG ;
  20. FROM AmigaLib   IMPORT  DoSuperMethodA ;
  21. FROM DosD       IMPORT  ctrlC ;
  22. FROM ExecL      IMPORT  Wait ;
  23.  
  24. IMPORT
  25.         R,
  26.         gd  : GraphicsD,
  27.         gl  : GraphicsL,
  28.         id  : IntuitionD,
  29.         il  : IntuitionL,
  30.         m   : MuiD,
  31.         mc  : MuiClasses,
  32.         mcs : MuiClassSupport,
  33.         ml  : MuiL,
  34.         mm  : MuiMacros,
  35.         ms  : MuiSupport,
  36.         ud  : UtilityD,
  37.         ul  : UtilityL ;
  38.  
  39. (***************************************************************************)
  40. (* Here is the beginning of our new class...                               *)
  41. (***************************************************************************)
  42.  
  43. (*
  44. ** This is the instance data for our custom class.
  45. *)
  46.  
  47. TYPE
  48.   Data  = RECORD
  49.             x,
  50.             y,
  51.             sx,
  52.             sy : INTEGER ;
  53.           END (* RECORD *) ;
  54.  
  55. (*
  56. ** AskMinMax method will be called before the window is opened
  57. ** and before layout takes place. We need to tell MUI the
  58. ** minimum, maximum and default size of our object.
  59. *)
  60.  
  61. (*/// "mAskMinMax(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpAskMinMaxPtr) : ADDRES" *)
  62.  
  63. PROCEDURE mAskMinMax(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpAskMinMaxPtr) : ADDRESS;
  64.  
  65. BEGIN
  66.   (*
  67.   ** let our superclass first fill in what it thinks about sizes.
  68.   ** this will e.g. add the size of frame and inner spacing.
  69.   *)
  70.  
  71.   IF DoSuperMethodA(cl, obj, msg) # NIL THEN END ;
  72.  
  73.   (*
  74.   ** now add the values specific to our object. note that we
  75.   ** indeed need to *add* these values, not just set them!
  76.   *)
  77.  
  78.   INC(msg^.MinMaxInfo^.MinWidth, 100) ;
  79.   INC(msg^.MinMaxInfo^.DefWidth, 120) ;
  80.   INC(msg^.MinMaxInfo^.MaxWidth, 500) ;
  81.  
  82.   INC(msg^.MinMaxInfo^.MinHeight, 40) ;
  83.   INC(msg^.MinMaxInfo^.DefHeight, 90) ;
  84.   INC(msg^.MinMaxInfo^.MaxHeight, 300) ;
  85.  
  86.   RETURN NIL ;
  87. END mAskMinMax ;
  88.  
  89. (*\\\*)
  90.  
  91. (*
  92. ** Draw method is called whenever MUI feels we should render
  93. ** our object. This usually happens after layout is finished
  94. ** or when we need to refresh in a simplerefresh window.
  95. ** Note: You may only render within the rectangle
  96. **       _mleft(obj), _mtop(obj), _mwidth(obj), _mheight(obj).
  97. *)
  98.  
  99. (*/// "mDraw(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpDrawPtr) : ADDRES" *)
  100.  
  101. PROCEDURE mDraw(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpDrawPtr) : ADDRESS;
  102.  
  103. VAR
  104.   data : POINTER TO Data ;
  105.  
  106. BEGIN
  107.   data := mc.InstData(cl, obj) ;
  108.  
  109.   (*
  110.   ** let our superclass draw itself first, area class would
  111.   ** e.g. draw the frame and clear the whole region. What
  112.   ** it does exactly depends on msg->flags.
  113.   **
  114.   ** Note: You *must* call the super method prior to do
  115.   ** anything else, otherwise msg->flags will not be set
  116.   ** properly !!!
  117.   *)
  118.  
  119.   IF DoSuperMethodA(cl, obj, msg) # NIL THEN END ;
  120.  
  121.   (*
  122.   ** if MADF_DRAWOBJECT isn't set, we shouldn't draw anything.
  123.   ** MUI just wanted to update the frame or something like that.
  124.   *)
  125.  
  126.   IF mc.drawUpdate IN msg^.flags THEN
  127.     IF (data^.sx # 0) OR (data^.sy # 0) THEN
  128.       gl.SetBPen(mc.OBJ_rp(obj),mc.OBJ_dri(obj)^.pens^[id.shinePen]) ;
  129.       gl.ScrollRaster(mc.OBJ_rp(obj),data^.sx,data^.sy,mc.OBJ_mleft(obj),mc.OBJ_mtop(obj),mc.OBJ_mright(obj),mc.OBJ_mbottom(obj));
  130.       gl.SetBPen(mc.OBJ_rp(obj),0);
  131.       data^.sx := 0;
  132.       data^.sy := 0;
  133.     ELSE
  134.       gl.SetAPen(mc.OBJ_rp(obj),mc.OBJ_dri(obj)^.pens^[id.shadowPen]);
  135.       IF gl.WritePixel(mc.OBJ_rp(obj),data^.x,data^.y) THEN END ;
  136.     END (* IF *) ;
  137.   ELSIF mc.drawObject IN msg^.flags THEN
  138.     gl.SetAPen(mc.OBJ_rp(obj),mc.OBJ_dri(obj)^.pens^[id.shinePen]);
  139.     gl.RectFill(mc.OBJ_rp(obj),mc.OBJ_mleft(obj),mc.OBJ_mtop(obj),mc.OBJ_mright(obj),mc.OBJ_mbottom(obj));
  140.   END (* IF *) ;
  141.  
  142.   RETURN NIL ;
  143. END mDraw ;
  144.  
  145. (*\\\*)
  146. (*/// "mSetup(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRES" *)
  147.  
  148. PROCEDURE mSetup(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRESS;
  149.  
  150. BEGIN
  151.   IF DoSuperMethodA(cl, obj, msg) = NIL THEN RETURN LONGINT(FALSE) END ;
  152.  
  153.   ml.moRequestIDCMP(obj,id.IDCMPFlagSet{id.mouseButtons, id.rawKey}) ;
  154.   RETURN LONGINT(TRUE) ;
  155. END mSetup ;
  156.  
  157. (*\\\*)
  158. (*/// "mCleanup(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRES" *)
  159.  
  160. PROCEDURE mCleanup(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRESS;
  161.  
  162. BEGIN
  163.   ml.moRejectIDCMP(obj,id.IDCMPFlagSet{id.mouseButtons, id.rawKey}) ;
  164.  
  165.   RETURN DoSuperMethodA(cl, obj, msg) ;
  166. END mCleanup;
  167.  
  168. (*\\\*)
  169. (*/// "mHandleInput(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRES" *)
  170.  
  171. PROCEDURE mHandleInput(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRESS;
  172.  
  173.   PROCEDURE Between(a, x, b : LONGINT) : BOOLEAN ;
  174.   BEGIN
  175.     RETURN (x >= a) AND (x <= b) ;
  176.   END Between ;
  177.  
  178.   PROCEDURE IsInObject(x, y : LONGINT) : BOOLEAN ;
  179.   BEGIN
  180.     RETURN Between(mc.OBJ_mleft(obj), x, mc.OBJ_mright(obj)) AND Between(mc.OBJ_mtop(obj), y, mc.OBJ_mbottom(obj)) ;
  181.   END IsInObject;
  182.  
  183. VAR
  184.   data : POINTER TO Data ;
  185.  
  186. BEGIN
  187.   data := mc.InstData(cl, obj) ;
  188.  
  189.   IF msg^.muikey # 0 THEN
  190.     CASE msg^.muikey OF
  191.     | mc.MUIKEYLEFT  : data^.sx := -1 ; IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  192.     | mc.MUIKEYRIGHT : data^.sx :=  1 ; IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  193.     | mc.MUIKEYUP    : data^.sy := -1 ; IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  194.     | mc.MUIKEYDOWN  : data^.sy :=  1 ; IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  195.     ELSE
  196.     END (* CASE *) ;
  197.   END (* IF *) ;
  198.  
  199.   IF msg^.imsg # NIL THEN
  200.     IF id.mouseButtons IN msg^.imsg^.class THEN
  201.       IF msg^.imsg^.code = id.selectDown THEN
  202.         IF IsInObject(msg^.imsg^.mouseX, msg^.imsg^.mouseY) THEN
  203.           data^.x := msg^.imsg^.mouseX ;
  204.           data^.y := msg^.imsg^.mouseY ;
  205.           IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  206.           ml.moRequestIDCMP(obj, id.IDCMPFlagSet{id.mouseMove}) ;
  207.         END (* IF *) ;
  208.       ELSE
  209.         ml.moRejectIDCMP(obj, id.IDCMPFlagSet{id.mouseMove}) ;
  210.       END (* IF *) ;
  211.     ELSIF id.mouseMove IN msg^.imsg^.class THEN
  212.       IF IsInObject(msg^.imsg^.mouseX, msg^.imsg^.mouseY) THEN
  213.         data^.x := msg^.imsg^.mouseX ;
  214.         data^.y := msg^.imsg^.mouseY ;
  215.         IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  216.       END (* IF *) ;
  217.     END (* IF *)
  218.   END (* IF *) ;
  219.  
  220.   RETURN DoSuperMethodA(cl, obj, msg) ;
  221. END mHandleInput ;
  222.  
  223. (*\\\*)
  224.  
  225. (*
  226. ** Here comes the dispatcher for our custom class. 
  227. ** Unknown/unused methods are passed to the superclass immediately.
  228. *)
  229.  
  230. (*/// "MyDispatcher(cl : id.IClassPtr; obj : ADDRESS; msg : ADDRESS) : ADDRESS" *)
  231.  
  232. PROCEDURE MyDispatcher(cl : id.IClassPtr; obj : ADDRESS; msg : ADDRESS) : ADDRESS ;
  233.  
  234. VAR
  235.   mid : LONGCARD ;
  236.  
  237. BEGIN
  238.   mid := CAST(id.Msg, msg)^.methodID ;
  239.  
  240.      IF mid = m.mmAskMinMax   THEN RETURN mAskMinMax(cl, obj, msg)
  241.   ELSIF mid = m.mmSetup       THEN RETURN mSetup(cl, obj, msg)
  242.   ELSIF mid = m.mmCleanup     THEN RETURN mCleanup(cl, obj, msg)
  243.   ELSIF mid = m.mmDraw        THEN RETURN mDraw(cl, obj, msg)
  244.   ELSIF mid = m.mmHandleInput THEN RETURN mHandleInput(cl, obj, msg)
  245.   ELSE
  246.     RETURN DoSuperMethodA(cl, obj, msg)
  247.   END (* CASE *) ;
  248. END MyDispatcher ;
  249.  
  250. (*\\\*)
  251.  
  252. (***************************************************************************)
  253. (* Thats all there is about it. Now lets see how things are used...        *)
  254. (***************************************************************************)
  255.  
  256. VAR
  257.   app,
  258.   window,
  259.   grp,
  260.   myObj,
  261.   text     :  id.ObjectPtr ;
  262.   mcc      :  mc.mCustomClassPtr ;
  263.   signals  :  LONGSET ;
  264.   running  := BOOLEAN{TRUE} ;
  265.   myDispatcher : ADDRESS ;
  266.   NULL     := ADDRESS{NIL} ;
  267.  
  268.   tags     :  ARRAY [0..31] OF LONGINT ;
  269.  
  270. BEGIN
  271.  
  272.   (* Create the new custom class with a call to MUI_CreateCustomClass(). *)
  273.   (* Caution: This function returns not a struct IClass, but a           *)
  274.   (* struct MUI_CustomClass which contains a struct IClass to be         *)
  275.   (* used with NewObject() calls.                                        *)
  276.   (* Note well: MUI creates the dispatcher hook for you, you may         *)
  277.   (* *not* use its h_Data field! If you need custom data, use the        *)
  278.   (* cl_UserData of the IClass structure!                                *)
  279.  
  280.   IF ml.muiMasterVersion < 11 THEN ms.fail(NULL, "You need MUI 3 to run this demo.") END;
  281.  
  282.   IF NOT mcs.InitClass(mcc, NIL, ADR(m.mcArea), NIL, SIZE(Data), MyDispatcher) THEN
  283.     ms.fail(NULL, "Could not create custom class.")
  284.   END (* IF *) ;
  285.  
  286.   mc.MakeDispatcher(MyDispatcher, mcc^.class) ;
  287.  
  288.   myObj := il.NewObjectA(mcc^.class, NIL, TAG(tags, m.maFrame,       m.mvFrameText,
  289.                                               ud.tagDone)) ;
  290.  
  291.   text := mm.TextObject(TAG(tags, m.maFrame,        m.mvFrameText,
  292.                                   m.maBackground,   m.miTextBack,
  293.                                   m.maTextContents, ADR("\ecPaint with mouse,\nscroll with cursor keys."),
  294.                             ud.tagDone)) ;
  295.  
  296.   grp := mm.GroupObject(TAG(tags, m.maGroupHoriz, FALSE,
  297.                                   mm.Child,       text,
  298.                                   mm.Child,       myObj,
  299.                             ud.tagDone)) ;
  300.  
  301.  
  302.   window := mm.WindowObject(TAG(tags, m.maWindowTitle, ADR("A rather complex custom class"),
  303.                                       m.maWindowID,    mm.MakeID("CLS3"),
  304.                                       mm.WindowContents, grp,
  305.                                 ud.tagDone)) ;
  306.  
  307.   app := mm.ApplicationObject(TAG(tags, m.maApplicationTitle,       ADR("Class3-M2"),
  308.                                         m.maApplicationVersion,     ADR("$VER: Class3-M2 11.1 (22.9.95)"),
  309.                                         m.maApplicationCopyright,   ADR("©1995, Olaf Peters, Stefan Stuntz"),
  310.                                         m.maApplicationAuthor,      ADR("Olaf Peters, Stefan Stuntz"),
  311.                                         m.maApplicationDescription, ADR("Demonstrate the use of custom classes."),
  312.                                         m.maApplicationBase,        ADR("CLASS3M2"),
  313.                                         mm.SubWindow,               window,
  314.                                   ud.tagDone)) ;
  315.  
  316.   IF app = NIL THEN ms.fail(NULL, "Failed to create Application.") END ;
  317.  
  318.   mm.set(window,m.maWindowDefaultObject, LONGCARD(myObj)) ;
  319.  
  320.   mm.NoteClose(app, window, m.mvApplicationReturnIDQuit) ; 
  321.  
  322.  
  323. (*
  324. ** Input loop...
  325. *)
  326.  
  327.   mm.set(window, m.maWindowOpen, LONGCARD(TRUE)) ;
  328.  
  329.   signals := LONGSET{} ;
  330.  
  331.   LOOP
  332.     IF ms.DOMethod(app, TAG(tags, m.mmApplicationNewInput, ADR(signals))) = m.mvApplicationReturnIDQuit THEN EXIT END ;
  333.  
  334.     IF signals # LONGSET{} THEN
  335.       INCL(signals, ctrlC) ;
  336.       signals := Wait(signals) ;
  337.       IF ctrlC IN signals THEN EXIT END ;
  338.     END (* IF *) ;
  339.   END (* WHILE *) ;
  340.  
  341.   mm.set(window, m.maWindowOpen, LONGCARD(FALSE)) ;
  342.  
  343.  
  344. (*
  345. ** Shut down...
  346. *)
  347.  
  348. CLOSE
  349.   IF app # NIL THEN
  350.     ml.mDisposeObject(app) ;
  351.     app := NIL ;
  352.   END (* IF *) ;
  353.  
  354.   mcs.RemoveClass(mcc) ;
  355. END Class3.
  356.